home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue44 / HTMLmove / ContextM.pas next >
Encoding:
Pascal/Delphi Source File  |  1999-02-10  |  3.4 KB  |  125 lines
  1. unit ContextM;
  2.  
  3. interface
  4.  
  5. uses
  6.     Windows, ComObj, ComServ, ShlObj, ActiveX, ShellApi, SysUtils,
  7.     Classes, WizMain;
  8.  
  9. Const
  10.     CLSID_ContextMenuShellExtension: TGUID = (
  11.     D1:$9F2214C0; D2:$2002; D3:$11D2; D4:($AF, $3E, $44, $45, $53, $54, $00, $00));
  12.  
  13. type
  14.     TContextMenu = class(TComObject, IShellExtInit, IContextMenu)
  15.     private
  16.       szFile: array[0..MAX_PATH] of Char;
  17.       szFiles: array of string;
  18.     public
  19.       function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast,
  20.         uFlags: UINT): HResult; stdcall;
  21.       function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
  22.       function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
  23.         pszName: LPSTR; cchMax: UINT): HResult; stdcall;
  24.       function Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
  25.         hKeyProgID: HKEY): HResult; stdcall;
  26.     end;
  27.  
  28. implementation
  29.  
  30. function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,
  31.           idCmdLast, uFlags: UINT): HResult;
  32. begin
  33.   // Add one menu item to context menu
  34.   InsertMenu (Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst,
  35.     'Move Html Files...');
  36.   // Return number of menu items added
  37.   Result := 1;
  38. end;
  39.  
  40. function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
  41. var
  42.   i: integer;
  43. begin
  44.   // Make sure we are not being called by an application
  45.   if HiWord(Integer(lpici.lpVerb)) <> 0 then
  46.   begin
  47.     Result := E_FAIL;
  48.     Exit;
  49.   end;
  50.   // Make sure we aren't being passed an invalid argument number
  51.   if LoWord(lpici.lpVerb) > 0 then
  52.   begin
  53.     Result := E_INVALIDARG;
  54.     Exit;
  55.   end;
  56.   // Execute the command specified by lpici.lpVerb.
  57.   if LoWord(lpici.lpVerb) = 0 then
  58.   begin
  59.     // try to invoke window here
  60.     with TWizardMain.Create(nil) do
  61.     begin
  62.       for i := 0 to Length(szFiles)-1 do
  63.         ListBox1.Items.Add(szFiles[i]);
  64.       ShowModal;
  65.       Free;
  66.     end;
  67.   end;
  68.   Result := NOERROR;
  69. end;
  70.  
  71. function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
  72.   pszName: LPSTR; cchMax: UINT): HRESULT;
  73. begin
  74.   if idCmd = 0 then
  75.   begin
  76.     // return help string for menu item
  77.     strCopy(pszName, 'Invoke HomeGrown''s Html file move wizard');
  78.     Result := NOERROR;
  79.   end
  80.   else
  81.     Result := E_INVALIDARG;
  82. end;
  83.  
  84. function TContextMenu.Initialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
  85.   hKeyProgID: HKEY): HResult;
  86. var
  87.   medium: TStgMedium;
  88.   fe: TFormatEtc;
  89.   i: integer;
  90. begin
  91.   with fe do
  92.   begin
  93.     cfFormat := CF_HDROP;
  94.     ptd := Nil;
  95.     dwAspect := DVASPECT_CONTENT;
  96.     lindex := -1;
  97.     tymed := TYMED_HGLOBAL;
  98.   end;
  99.   // Fail the call if lpdobj is Nil.
  100.   if lpdobj = Nil then
  101.   begin
  102.     Result := E_FAIL;
  103.     Exit;
  104.   end;
  105.   // Render the data referenced by the IDataObject pointer to an HGLOBAL
  106.   // storage medium in CF_HDROP format.
  107.   Result := lpdobj.GetData(fe, medium);
  108.   if Failed(Result) then Exit;
  109.   // copy all the files into szFiles
  110.   for i := 0 to DragQueryFile(medium.hGlobal, $FFFFFFFF, Nil, 0)-1 do
  111.   begin
  112.     DragQueryFile(medium.hGlobal, i, szFile, SizeOf(szFile));
  113.     SetLength(szFiles, Length(szFiles)+1);
  114.     szFiles[Length(szFiles)-1] := string(szFile);
  115.   end;
  116.   Result := NOERROR;
  117.   ReleaseStgMedium(medium);
  118. end;
  119.  
  120. initialization
  121.     TComObjectFactory.Create(ComServer, TContextMenu, CLSID_ContextMenuShellExtension,
  122.          '', 'HomeGrown''s Html File Mover', ciMultiInstance);
  123.  
  124. end.
  125.